home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / freetype.zip / ttcalc.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-07  |  14KB  |  552 lines
  1. {****************************************************************************}
  2. {*                                                                          *}
  3. {*  TTCalc                                                                  *}
  4. {*                                                                          *}
  5. {*  This units holds most of the arithmetic and vectorial operations        *}
  6. {*  used by the FreeType engine.                                            *}
  7. {*                                                                          *}
  8. {****************************************************************************}
  9.  
  10. unit TTCalc;
  11.  
  12. interface
  13.  
  14. uses TTTypes, TTError, TTVars;
  15.  
  16.  
  17. procedure Do16( var S );
  18. procedure Do16s( var S; Cnt : Int );
  19. procedure Do32( var L );
  20. procedure Do32s( var L; Cnt : int );
  21.  
  22. function MulDiv( A, B, C : Int32 ): Int32;
  23.  
  24. procedure Add64( var X, Y, Z : Int64 );
  25. procedure Sub64( var X, Y, Z : Int64 );
  26. procedure MulTo64( X, Y : Int32; var Z : Int64 );
  27.  
  28. function Div64by32( var X : Int64; Y : Int32 ) : Int32;
  29. function Order64( var Z : Int64 ) : int;
  30. function Order32( Z : Int32 ) : int;
  31. function Sqrt32( L : LongInt ): LongInt;
  32. function Sqrt64( L : Int64 ): LongInt;
  33.  
  34. function MulVec( var L : Int64;        (* This is 48 bits number *)
  35.                      F : TUnitVector;  (* Freedom vector         *)
  36.                      P : TUnitVector;  (* Projection vector      *)
  37.                  var R : TVector       (* Result Vector          *)
  38.                )
  39.                : boolean;
  40.  
  41. function Norm( X, Y : F26dot6 ): F26dot6;
  42. function UnitNorm( V : TUnitVector ): F2dot14;
  43. function Dot( U, V : TVector ): F26dot6;
  44. function Project( V : TVector; U : TUnitVector ): F26dot6;
  45.  
  46. function MoveVec1 ( var V : TVector; H : F26dot6 ) : boolean;
  47.  
  48. function MoveVec2 ( var V : TVector; H : F26dot6;
  49.                     var V2 : TVector )
  50.                                        : boolean;
  51.  
  52. function AlignVecs( var A, B : TVector
  53.                   )
  54.                   : boolean;
  55.  
  56. function Barycentre( var A1, B1, I1, A2, B2 : TVector;
  57.                      var I2 : TVector
  58.                   )
  59.                   : boolean;
  60.  
  61. function Interpolate( A1, B1, I1,
  62.                       A2, B2      : F26dot6;
  63.                       var I2      : F26dot6
  64.                     )
  65.                     : boolean;
  66.  
  67. function Normalize( U, V : F26dot6; var R : TUnitVector ): boolean;
  68.  
  69. function Intersect( var A, B, C, D : TVector;
  70.                     var R : TVector
  71.                   )
  72.                   : boolean;
  73.  
  74.  
  75. implementation
  76.  
  77.  
  78. (* Load the appropriate implementation of processor and
  79.    bitness dependent routines                            *)
  80.  
  81. {$IFDEF OS2}
  82. {$I TTCALC32.INC}
  83. {$ELSE}
  84. {$I TTCALC16.INC}
  85. {$ENDIF}
  86.  
  87. const
  88.   Roots : array[0..62] of LongInt
  89.         = (
  90.                1,    1,    2,     3,     4,     5,     8,    11,
  91.               16,   22,   32,    45,    64,    90,   128,   181,
  92.              256,  362,  512,   724,  1024,  1448,  2048,  2896,
  93.             4096, 5892, 8192, 11585, 16384, 23170, 32768, 46340,
  94.  
  95.               65536,   92681,  131072,   185363,   262144,   370727,
  96.              524288,  741455, 1048576,  1482910,  2097152,  2965820,
  97.             4194304, 5931641, 8388608, 11863283, 16777216, 23726566,
  98.  
  99.               33554432,   47453132,   67108864,   94906265,
  100.              134217728,  189812531,  268435456,  379625062,
  101.              536870912,  759250125, 1073741824, 1518500250,
  102.             2147483647
  103.           );
  104.  
  105.  
  106. (**************************************************)
  107. (* Integer Square Root                            *)
  108.  
  109. function Sqrt32( L : LongInt ): LongInt;
  110. var
  111.   R, S : LongInt;
  112. begin
  113.   if L<=0 then Sqrt32:=0 else
  114.   if L=1 then Sqrt32:=1 else
  115.    begin
  116.     R:=Roots[ Order32(L) ];
  117.  
  118.     Repeat
  119.      S:=R;
  120.      R:=( R+ L div R ) shr 1;
  121.     until ( R<=S ) and ( R*R<=L );
  122.  
  123.     Sqrt32:=R;
  124.    end;
  125. end;
  126.  
  127.  
  128. (**************************************************)
  129. (* Integer Square Root                            *)
  130.  
  131. function Sqrt64( L : Int64 ): LongInt;
  132. var
  133.   L2   : Int64;
  134.   R, S : LongInt;
  135. begin
  136.   if L.Hi<0 then Sqrt64:=0 else
  137.    begin
  138.     S := Order64(L);
  139.     if S=0 then Sqrt64:=1 else
  140.      begin
  141.       R:=Roots[S];
  142.  
  143.       Repeat
  144.        S:=R;
  145.        R:=( R+Div64by32(L,R) ) shr 1;
  146.        MulTo64 ( R,  R, L2 );
  147.        Sub64   ( L, L2, L2 );
  148.       until ( R<=S ) and ( L2.Hi>=0 );
  149.  
  150.       Sqrt64:=R;
  151.      end
  152.    end
  153. end;
  154.  
  155.  
  156. (*******************************************************)
  157. (* Special routine used to compute point displacements *)
  158. (*                                                     *)
  159. (* This routine could be optimized to inline assembly  *)
  160. (* for those of you concerned with speed               *)
  161.  
  162.  
  163. function MulVec( var L : Int64;        (* This is 48 bits number *)
  164.                      F : TUnitVector;  (* Freedom vector         *)
  165.                      P : TUnitVector;  (* Projection vector      *)
  166.                  var R : TVector       (* Result Vector          *)
  167.                )
  168.                : boolean;
  169. var
  170.   A, B : Int32;
  171.   T, T2: Int64;
  172. begin
  173.   B := Int32(F.x)*P.x + Int32(F.y)*P.y;
  174.   if B=0 then
  175.    begin
  176.     MulVec:=False;   (*  B := Fx.Px + Fy.Py  *)
  177.     R.x:=0;
  178.     R.y:=0;
  179.     exit;
  180.    end;
  181.  
  182.   MulTo64( L.Lo, F.x, T  );
  183.   MulTo64( L.Hi, F.x, T2 );
  184.   Inc( T.Hi, T2.Lo );
  185.  
  186.   R.x := Div64by32( T, B ); (*  Rx := L*Fx/B  *)
  187.  
  188.   MulTo64( L.Lo, F.y, T  );
  189.   MulTo64( L.Hi, F.y, T2 );
  190.   Inc( T.Hi, T2.Lo );
  191.  
  192.   R.y := Div64by32( T, B ); (*  Ry := L*Fy/B  *)
  193.  
  194.   MulVec:=True;
  195. end;
  196.  
  197.  
  198. (**************************************************)
  199. (* Vector length                                  *)
  200.  
  201. function Norm( X, Y : F26dot6 ): F26dot6;
  202. var
  203.   T1, T2 : Int64;
  204. begin
  205.   MulTo64( X, X, T1 );
  206.   MulTo64( Y, Y, T2 );
  207.   Add64( T1, T2, T1 );
  208.   Norm := Sqrt64( T1 );
  209. end;
  210.  
  211.  
  212. (**************************************************)
  213. (* Unit vector Length                             *)
  214.  
  215. function UnitNorm( V : TUnitVector ): F2dot14;
  216. begin
  217.   UnitNorm := Sqrt32( Int32(V.x)*V.x + Int32(V.y)*V.y );
  218. end;
  219.  
  220.  
  221.  
  222. (**************************************************)
  223. (* Scalar vector product                          *)
  224.  
  225. function Dot( U, V : TVector ): F26dot6;
  226. var
  227.   T1, T2 : Int64;
  228. begin
  229.   MulTo64( U.x, V.x, T1 );
  230.   MulTo64( U.y, V.y, T2 );
  231.   Add64( T1, T2, T1 );
  232.   Dot := Div64by32( T1, 64 );
  233. end;
  234.  
  235.  
  236. (**************************************************)
  237. (* Projection                                     *)
  238.  
  239. function Project( V : TVector; U : TUnitVector ): F26dot6;
  240. var
  241.   T1, T2 : Int64;
  242. begin
  243.   MulTo64( V.x, U.x, T1 );
  244.   MulTo64( V.x, U.x, T2 );
  245.   Add64( T1, T2, T1 );
  246.   Project := Div64by32( T1, $4000 );
  247. end;
  248.  
  249.  
  250. (**************************************************)
  251. (*                                                *)
  252. (* MoveVec1   : Move a point according to         *)
  253. (*              PV and FV                         *)
  254. (*              FALSE if PV.FV = 0                *)
  255. (**************************************************)
  256.  
  257. function MoveVec1( var V : TVector; H : F26dot6 ) : boolean;
  258. var
  259.  T    : Int64;
  260.  R    : TVector;
  261. begin
  262.   with GS do
  263.    with V do
  264.     begin
  265.  
  266.      MulTo64( H, $4000, T );
  267.  
  268.      if MulVec( T, freeVector,
  269.                    projVector,
  270.                 R )
  271.       then
  272.        begin
  273.         inc( X, R.x );
  274.         inc( Y, R.y );
  275.         MoveVec1:=True;
  276.        end
  277.  
  278.      else
  279.       begin
  280.        MoveVec1:=False;
  281.        Error:=TT_ErrMsg_Divide_By_Zero;
  282.       end
  283.  
  284.     end
  285. end;
  286.  
  287.  
  288. (**************************************************)
  289. (*                                                *)
  290. (* MoveVec2   : Déplace un point en fonction des  *)
  291. (*              PV et FV                          *)
  292. (*              FALSE si PV.FV = 0                *)
  293. (**************************************************)
  294.  
  295. function MoveVec2 ( var V : TVector; H : F26dot6;
  296.                     var V2 : TVector )
  297.                                        : boolean;
  298. var
  299.   R  : TVector;
  300.   T1,
  301.   T2 : Int64;
  302.  
  303. begin
  304.   with GS do
  305.    with V do
  306.